      program demotrap
C     See if can use 'Printer traps' via $A8FD PrGlue and TOOLBX.sub
C  A simple sample program demonstrating its capability for Absoft Fortran 2.3.
C  This program does not actually do any printing.
C  J. Lieske 12/87

C * * * * * * * * * *
* FUNCTION PTR (ANYTYPE) : PTR;                ; A funny trap.
        INTEGER PTR                             ! from Absoft's MISC.inc
        PARAMETER (PTR=Z'C0000000')

      integer NEWHANDLE             ! from Absoft's MEMORY.inc
      parameter (NEWHANDLE=Z'122000A8')
      integer iPrintSize            ! The Print record size.[120 bytes]
      parameter (iPrintSize=120)    ! from Absoft's PRDEFS.inc
C * * * * * * * * * *
C   GRXMX0 : default x size (pixels).  These will be taken from the print record
C   GRYMX0 : default y size (pixels)
C   GRXPIN : pixels per inch in x
C   GRYPIN : pixels per inch in y
      REAL  GRXPIN, GRYPIN
      INTEGER   GRXMX0, GRYMX0
      INTEGER*4 TOOLBX                    ! MAC TOOLBOX INTERFACE

x     integer*4 debugger                  ! just in case you want to use MacsBug
x     parameter (debugger=z'9FF00000')
x     call toolbx(debugger)               ! put the call where it's needed
*
* INITIALIZE THE PRINT RECORD FOR THE MACINTOSH
*
      integer*2 iversion
      integer*2 ernum

* PRINT MANAGER FUNCTION DEFINITIONS for toolbox-based traps
      include prtrap.inc
      include PrGenDefs.inc

      INTEGER PRRECHDL                    ! HANDLE TO THE PRINT RECORD.
      INTEGER POINT                       ! DEREFERENCED HANDLE
      LOGICAL OK

      write(*,*) 'This program demonstrates printer traps in Fortran.'
      write(*,*) 'It won''t actually print anything, but shows how to'
      write(*,*) 'access the printer traps in Absoft Fortran.'  
      write(*,*) 'It will write the data out to ''output.fil'''
      write(*,*) 'so you can read it.'

      call toolbx(propen, xpropen)  ! PrOpen

      PRRECHDL = TOOLBX(NEWHANDLE, IPRINTSIZE)  ! GET A PRINT RECORD HANDLE.
      call toolbx(printdefault,PRRECHDL,xprintdefault)      ! get defaults

C  get printer version number
      iversion = toolbx(prdrvrvers, xprdrvrvers )
      write (*,*) 'iversion = ', iversion
      open(15,file='output.fil', status='NEW')
      write (15,*) 'iversion = ', iversion

C  see if PrGeneral will work
      gOpCode = 4       ! set iOpCode
C--use PTR to get address of data record
      pGetRslData = toolbx(PTR,GetRslDataRec)
      call toolbx(PrGeneral, pGetRslData, xPrGeneral)
C  should now check for PrError also
      ernum = toolbx(PrError, xPrError)
      write(*,*) 'PrError number = ', ernum
      write(15,*) 'PrError number = ', ernum

      write(*,*) 'Interpreted record'
      write(*,*) 'iOpCode= ',gOpCode
      write(*,*) 'iError= ',gError
      write(*,*) 'lReserved= ',gReserved
      write(*,*) 'iRgType= ',iRgType
      write(*,*) 'XRslRg= ',XRslRg
      write(*,*) 'YRslRg= ',YRslRg
      write(*,*) 'iRslRecCnt= ',iRslRecCnt
      write(*,*) 'rgRslRec= ',((rgRslRec(i,j), i=1,2), j=1,iRslRecCnt)

      write(15,*) 'Interpreted record'
      write(15,*) 'iOpCode= ',gOpCode
      write(15,*) 'iError= ',gError
      write(15,*) 'lReserved= ',gReserved
      write(15,*) 'iRgType= ',iRgType
      write(15,*) 'XRslRg= ',XRslRg
      write(15,*) 'YRslRg= ',YRslRg
      write(15,*) 'iRslRecCnt= ',iRslRecCnt
      write(15,*) 'rgRslRec= ',((rgRslRec(i,j), i=1,2), j=1,iRslRecCnt)

C now try to set it to 300 dpi
      pOpCode = 5       ! set iOpCode for SetRsl
      hPrint = PRRECHDL ! handle to print record
      iXRsl = 300
      iYRsl = 300
      pSetRsl = toolbx(PTR,SetRslRec)
      call toolbx(PrGeneral, pSetRsl, xPrGeneral)

      OK = toolbx(prstldialog,PRRECHDL,xprstldialog)  ! std dialog

      OK=toolbx(prjobdialog,PRRECHDL,xprjobdialog)    ! PrJobDialog
      if (.not. OK) STOP
*     NOW READ PLOT DIMENSION VALUES WITH THOSE FROM THE PRINTER INFO RECORD.
*     PRRECHDL IS A HANDLE TO THE PRINTER RECORD WHICH IS 120 BYTES
*     THE VALUES WE CARE ABOUT ARE THE VERTICAL AND HORIZONTAL RESOLUTION
*     AND THE PAGE RECTANGLE WHICH ARE AT OFFSETS 4,6, AND 8 INTO THE RECORD

      POINT=LONG(PRRECHDL)
      GRXMX0 = WORD(POINT+14)
      GRYMX0 = WORD(POINT+12)
      GRXPIN = FLOAT(WORD(POINT+6))
      GRYPIN = FLOAT(WORD(POINT+4))
      write(*,*)  'resolutions', GRXMX0,GRYMX0,GRXPIN,GRYPIN
      write(15,*)  'resolutions',GRXMX0,GRYMX0,GRXPIN,GRYPIN
      close(15)


*
*     CLOSE UP THE PRINTER
*
      call toolbx(prclose,xprclose)       ! Close the printing grafport

      pause 'Press return to exit'
      stop
      end
